Code
colnames_to_underscores <- function(data = NULL) {
dat <- data
names(dat) <- stringr::str_replace_all(names(dat), pattern = " ", replacement = "_")
return(dat)
}main_analysis_withoutoutlires
General analysis plan
Our analysis will evaluate the pilot outcomes for the Perceived Social Categorization Study. Participants rated the same set of 85 photos for perceived “Jewishness” and “Arabness.” Our objective is to pinpoint images where the average ratings across these two dimensions do not significantly diverge. This nuanced approach enables us to select images that best represent a balanced perception, laying a robust foundation for our main study and ensuring the integrity and relevance of our visual stimuli.
Data importation and initial preparation
helper function’s
standardize column names
Utilize the provided helper function colnames_to_underscores to standardize column names by replacing spaces and special characters with underscores.
get_summary_stats_function
Code
get_summary_stats <- function(demo_wide_clean) {
summary_stats <- summary(demo_wide_clean)
return(summary_stats)
}Data Importation and Initial Preparation:
Import data sets related to the main task, attention checks, and demographics.
Code
data_categorization_jwish_first <- read_csv("../Data/data_exp_143127-v17_task-jwishfirstrealdata.csv", show_col_types = FALSE)
data_categorization_Arab_first <- read_csv("../Data/data_exp_143127-v17_task-4qo7Arabfirstrealdata.csv", show_col_types = FALSE)
att_check <- read_csv("../Data/data_exp_143127-v17_task-sfst_ATTcheck.csv", show_col_types = F)
data_demo <- read_csv("../Data/data_exp_143127-v17_questionnaire-jj6n_demo_all_long_for.csv", show_col_types = F)Attention Check and Participant Filtering:
Data arrangement(Binding- will not be nessasery in the actual analysis)
Code
att_check <- att_check |>
colnames_to_underscores() |>
dplyr::filter(str_detect(Zone_Type, pattern = "endValue")) |>
dplyr::select(Participant_Private_ID, Response) |>
dplyr::mutate(Participant_Private_ID = factor(Participant_Private_ID))Identify and exclude participants who failed the attention checks
Identifying who failed the attention checks (answer > 5)
Code
failed_IDs <- att_check |>
dplyr::filter(Response > 5) |>
dplyr::select(Participant_Private_ID)Data cleaning and Outlier Detection:
Cleaning data before filtering outliers
- Merge task-related data from different data- sets and filter out participants who failed the attention checks.
- Organizing the primary data for participants, including labeling and introducing a column to denote the order of conditions.
Code
library(dplyr)
data_participants <- rbind(data_categorization_Arab_first,data_categorization_jwish_first)|>
colnames_to_underscores() |>
dplyr::filter(!(Participant_Private_ID %in% failed_IDs$Participant_Private_ID)) |>
dplyr::filter(display %in% c("task_Jewish", "task_Arab")) |> # removing instructions screens
dplyr::filter(Zone_Type == "response_slider_endValue") |> # only subjects answers
dplyr::select(Participant_Private_ID, Response, image, Reaction_Time, display, Task_Name) |>
mutate(Participant_Private_ID = factor(Participant_Private_ID),
image = factor(image),
Task_Name = factor(Task_Name),
display = factor(display)) |>
mutate(Task_Name = case_when(
Task_Name == "Group_categorization_JewishFirst_pilot2" ~ "JewishFirst",
Task_Name == "Group_categorization_ArabFirst_pilot2" ~ "ArabFirst",
TRUE ~ Task_Name
)) |>
rename(order_of_conditions = Task_Name)
num_participants <- n_distinct(data_participants$Participant_Private_ID)data set without the subject-
exclude_participant_IDs <- c("10528079", "10515904", "10520649", "10529232")
# # Combine data and perform initial processing with dynamic exclusion
# data_participants_Without_10513794 <- data_participants|>
# dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))
#
# data_participants_Without_10515904 <- data_participants|>
# dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))
#
# data_participants_Without_10520649 <- data_participants|>
# dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))
#
# data_participants_Without_10528079 <- data_participants|>
# dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))
data_participants_without_all <- data_participants|>
dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))
num_participants <- n_distinct(data_participants_without_all$Participant_Private_ID)visualizing responses by display
Density plots for participants’ responses based on the dysplay conditions, labeled as “task Arab” versus “task Jewish.”
Code
# same but with outliers
density_plot <- ggplot(data_participants_without_all, aes(x = Response, fill = display)) +
geom_density(alpha = 0.5) + # Plot density
geom_rug(aes(color = display), sides = "b") + # Add rug plot at the bottom
scale_fill_brewer(palette = "Pastel1") + # Use Pastel1 palette for fill
scale_color_brewer(palette = "Pastel1") + # Use Pastel1 palette for rug and mean line colors
theme_minimal() +
labs(title = "Density of Ratings by Display", x = "Rating", y = "Density") +
geom_vline(data = data_participants_without_all %>% group_by(display) |>
summarise(mean_response = mean(Response, na.rm = TRUE)),
aes(xintercept = mean_response),
linetype = "dashed", color = "black", size = 0.5)
ggsave("density_plot_without_some_subjects.png", density_plot, path = "../Plots_outliers/", width = 10, height = 8, units = "in", bg = "white")Detecting outlires
Identify and exclude outliers from our data set using The MAD-median rule for outlier removal as recommended by Bakker and Wicherts (2014).
Second option to pbtain the MAD MEDIAN ROLE for detecting outlires (better in my opinion) link.
Code
#Threshold Determiantion
threshold <- 2.24
# Calculate the median and MAD for the Response column
median_response <- median(data_participants$Response, na.rm = TRUE)
mad_response <- mad(data_participants$Response, constant = 1, na.rm = TRUE)
lower_bound <- median_response - threshold * mad_response
upper_bound <- median_response + threshold * mad_response
outlier_indices <- which(data_participants$Response < lower_bound | data_participants$Response > upper_bound)
data_participants$is_outlier <- ifelse(data_participants$Response < lower_bound | data_participants$Response > upper_bound, 1, 0)
outliers <- data_participants[outlier_indices, ]
data_cleaned <- data_participants[!data_participants$Response %in% outliers$Response, ]
data_cleaned_without_some_subjects <- data_participants[!data_participants$Response %in% outliers$Response, ] |>
dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))
set.seed(14)
# test <- data_participants |>
# #mutate(is_outlier = sample(x = c(0, 1), size = nrow(data_participants), replace = T, prob = c(.8, .2))) |>
# filter(is_outlier == 1) |>
# group_by(Participant_Private_ID) |>
# mutate(n_trials = n()) |>
# mutate(bad_trials = 85*2 - n_trials) |>
# mutate(percent_bad_trials = n_bad_trials / (85*2))
# #filter(percent_bad_trials <= 0.2)
# library(dplyr)
test1 <- data_participants |>
# mutate(is_outlier = sample(x = c(0, 1), size = nrow(data_participants), replace = TRUE, prob = c(.8, .2))) |>
filter(is_outlier == 1) |>
group_by(Participant_Private_ID) |>
mutate(bad_trials = n(),
#bad_trials = 85 * 2 - n_trials,
percent_bad_trials = bad_trials / (85 * 2))
num_participants_out <- n_distinct(test1$Participant_Private_ID)SD table
A table showing the average standard deviation of each subject’s ratings beyond display types
Code
participant_sd_ratings <- data_participants_without_all |>
group_by(Participant_Private_ID) |>
summarise(SD_of_Ratings = sd(Response, na.rm = TRUE)) |>
ungroup()
kable(participant_sd_ratings, caption = "Standard Deviation of Ratings for Each Participant")| Participant_Private_ID | SD_of_Ratings |
|---|---|
| 10514858 | 19.72960 |
| 10515072 | 41.73836 |
| 10515173 | 23.39740 |
| 10515193 | 31.32064 |
| 10515201 | 36.83332 |
| 10515243 | 40.58422 |
| 10515319 | 35.68966 |
| 10515327 | 32.17920 |
| 10515918 | 22.24714 |
| 10515942 | 10.57305 |
| 10515960 | 19.62875 |
| 10515998 | 35.48673 |
| 10516258 | 24.88498 |
| 10516270 | 25.19615 |
| 10516302 | 29.10667 |
| 10516415 | 32.04238 |
| 10516645 | 22.79964 |
| 10516756 | 20.96220 |
| 10517522 | 29.27106 |
| 10517752 | 37.97194 |
| 10517925 | 40.37224 |
| 10518377 | 24.35308 |
| 10519057 | 37.29496 |
| 10519217 | 11.59149 |
| 10519319 | 29.61986 |
| 10519805 | 32.12981 |
| 10520066 | 21.90053 |
| 10520207 | 32.73827 |
| 10520244 | 25.67647 |
| 10520416 | 28.98994 |
| 10520443 | 26.83289 |
| 10520738 | 28.81733 |
| 10522475 | 29.30831 |
| 10522511 | 18.49479 |
| 10522561 | 27.52098 |
| 10527960 | 31.49570 |
| 10528402 | 12.17067 |
| 10528576 | 30.03514 |
| 10530076 | 37.41983 |
| 10530576 | 20.11152 |
| 10530858 | 29.53245 |
| 10531834 | 23.79220 |
examining order effect:
Examining how the order of conditions affects ratings of images as “Arab” or “Jewish,” to ensure there is no influence of presentation sequence on perceptions. Visualization of order effect
Code
# Visualization of order effects
order_effect_plot <- ggplot(data_participants_without_all, aes(x = order_of_conditions, y = Response, fill = display)) +
geom_boxplot() +
stat_summary(fun = mean, geom = "errorbar", aes(ymax = ..y.., ymin = ..y..), width = 0.75, color = "red") +
facet_wrap(~display, scales = "free") +
labs(title = "Order Effect on Ratings",
x = "Order of Conditions",
y = "Rating") +
theme_minimal() +
theme(plot.background = element_rect(fill = "white"), # Set plot background to white
panel.background = element_rect(fill = "white"), # Ensure panel background is white
text = element_text(color = "black")) + # Ensure text is black
scale_fill_brewer(palette = "Pastel1")
ggsave("order_effect_without_outlires.png", order_effect_plot, path = "../Plots_outliers/", width = 4000, height = 4000, units = "px")Perform a t-test to see if there’s a significant difference in ratings between orders
Code
mean_ratings_by_order <- data_participants_without_all |>
group_by(order_of_conditions, display) |>
summarise(mean_rating = mean(Response, na.rm = TRUE), .groups = 'drop') |>
pivot_wider(names_from = display, values_from = mean_rating)
t_test_result_jewish <- t.test(Response ~ order_of_conditions,
data = dplyr::filter(data_participants_without_all, display == "task_Jewish"),
alternative = "two.sided")
t_test_result_arab <- t.test(Response ~ order_of_conditions,
data = dplyr::filter(data_participants_without_all, display == "task_Arab"),
alternative = "two.sided")T-test result
Code
t_test_results_without_all <- data.frame(
Display = c("Jewish", "Arab"),
Statistic = c(t_test_result_jewish$statistic, t_test_result_arab$statistic),
P_Value = c(t_test_result_jewish$p.value, t_test_result_arab$p.value) # Difference of means, NA for the second row
)
# Create a table from the results
kable(t_test_results_without_all, caption = "T-Test Results for Jewish and Arab Displays", format = "markdown")| Display | Statistic | P_Value |
|---|---|---|
| Jewish | 1.602234 | 0.1091925 |
| Arab | -2.229192 | 0.0258633 |
Main task
Difference of means per image by display with a cutoff of 10 points difference between the ratings
- Analyze the main task by calculating and comparing mean responses for different image categories.
- Identify significant differences in means and categorize images based on these differences.
Code
data_images_10<- data_participants_without_all |>
group_by(image, Participant_Private_ID) |>
#dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))|>
dplyr::summarize(
task_Jewish = mean(Response[display == "task_Jewish"], na.rm = TRUE),
task_Arab = mean(Response[display == "task_Arab"], na.rm = TRUE),
.groups = 'drop' ) |> # Calculate the difference in ratings for each participant and image
mutate(diff_per_participant = task_Jewish - task_Arab) |>
# Aggregate at the image level
group_by(image) |>
dplyr::summarize(
avg_diff = mean(diff_per_participant, na.rm = TRUE),
.groups = 'drop') |># Classify based on the average difference
mutate(
rated_ethnicity = case_when(
avg_diff < -10 ~ "Arab",
avg_diff > 10 ~ "Jewish",
TRUE ~ "Ambiguous"
)
)|>
mutate(avg_diff = abs(avg_diff)) |>
arrange(avg_diff)
data_images_big_diff_10 <- data_images_10 |>
dplyr::filter(abs(avg_diff) >= 10) |>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
data_images_choosen_10 <- data_images_10 |>
dplyr::filter(abs(avg_diff)<10)|>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
kable(data_images_10, caption = "Difference of means with a cutoff of 10 points")| image | avg_diff | rated_ethnicity |
|---|---|---|
| CFD_M-242-N.png | 0.4047619 | Ambiguous |
| CFD_M-212-N.png | 0.5476190 | Ambiguous |
| IFD_M-419-N.png | 0.5714286 | Ambiguous |
| CFD_M-236-N.png | 1.2380952 | Ambiguous |
| CFD_M-220-N.png | 1.3809524 | Ambiguous |
| CFD_M-234-N.png | 1.5000000 | Ambiguous |
| CFD_M-206-N.png | 1.8809524 | Ambiguous |
| IFD_M-018-N.png | 2.1904762 | Ambiguous |
| CFD_M-227-N.png | 2.2142857 | Ambiguous |
| CFD_M-224-N.png | 2.8571429 | Ambiguous |
| CFD_M-218-N.png | 4.0952381 | Ambiguous |
| CFD_M-211-N.png | 4.9761905 | Ambiguous |
| IFD_M-108-N.png | 5.1666667 | Ambiguous |
| CFD_M-214-N.png | 5.3809524 | Ambiguous |
| IFD_M-135-N.png | 5.3809524 | Ambiguous |
| IFD_M-416-N.png | 5.8095238 | Ambiguous |
| IFD_M-105-N.png | 6.2142857 | Ambiguous |
| CFD_M-237-N.png | 6.3095238 | Ambiguous |
| CFD_M-216-N.png | 6.5000000 | Ambiguous |
| CFD_M-248-N.png | 6.8571429 | Ambiguous |
| CFD_M-243-N.png | 7.0238095 | Ambiguous |
| CFD_M-229-N.png | 7.3571429 | Ambiguous |
| IFD_M-086-N.png | 7.5476190 | Ambiguous |
| CFD_M-247-N.png | 7.5714286 | Ambiguous |
| IFD_M-067-N.png | 7.9761905 | Ambiguous |
| CFD_M-253-N.png | 8.2380952 | Ambiguous |
| IFD_M-424-N.png | 9.8095238 | Ambiguous |
| CFD_M-225-N.png | 9.8809524 | Ambiguous |
| IFD_M-132-N.png | 9.9523810 | Ambiguous |
| IFD_M-421-N.png | 10.0476190 | Jewish |
| IFD_M-136-N.png | 12.8809524 | Arab |
| IFD_M-420-N.png | 14.2619048 | Arab |
| CFD_M-213-N.png | 14.4047619 | Arab |
| IFD_M-117-N.png | 14.5952381 | Jewish |
| CFD_M-231-N.png | 14.7857143 | Jewish |
| CFD_M-222-N.png | 15.4047619 | Jewish |
| IFD_M-062-N.png | 15.4285714 | Arab |
| CFD_M-223-N.png | 15.6666667 | Arab |
| CFD_M-246-N.png | 16.1428571 | Arab |
| IFD_M-075-N.png | 16.7142857 | Arab |
| CFD_M-230-N.png | 16.8333333 | Arab |
| IFD_M-121-N.png | 16.8571429 | Jewish |
| IFD_M-036-N.png | 16.8809524 | Jewish |
| CFD_M-204-N.png | 16.9761905 | Jewish |
| IFD_M-100-N.png | 18.4285714 | Jewish |
| CFD_M-251-N.png | 18.6428571 | Jewish |
| IFD_M-042-N.png | 18.8809524 | Arab |
| IFD_M-122-N.png | 19.1190476 | Jewish |
| CFD_M-200-N.png | 19.3333333 | Jewish |
| CFD_M-221-N.png | 19.5952381 | Jewish |
| IFD_M-044-N.png | 19.6666667 | Arab |
| CFD_M-252-N.png | 20.0238095 | Arab |
| CFD_M-239-N.png | 20.2380952 | Arab |
| IFD_M-033-N.png | 21.1904762 | Jewish |
| IFD_M-418-N.png | 21.5238095 | Jewish |
| IFD_M-441-N.png | 22.7619048 | Jewish |
| IFD_M-021-N.png | 22.8095238 | Jewish |
| IFD_M-051-N.png | 23.1190476 | Arab |
| IFD_M-111-N.png | 23.1190476 | Arab |
| CFD_M-210-N.png | 23.2142857 | Arab |
| IFD_M-087-N.png | 24.5238095 | Jewish |
| CFD_M-238-N.png | 24.8571429 | Arab |
| IFD_M-015-N.png | 25.1190476 | Jewish |
| IFD_M-113-N.png | 25.9047619 | Jewish |
| IFD_M-084-N.png | 26.2142857 | Arab |
| CFD_M-232-N.png | 26.7857143 | Arab |
| IFD_M-097-N.png | 27.3571429 | Arab |
| IFD_M-032-N.png | 27.4285714 | Arab |
| IFD_M-020-N.png | 28.1666667 | Arab |
| IFD_M-035-N.png | 28.9285714 | Jewish |
| CFD_M-235-N.png | 29.5238095 | Arab |
| IFD_M-049-N.png | 29.8095238 | Arab |
| IFD_M-017-N.png | 33.7857143 | Jewish |
| IFD_M-114-N.png | 34.0714286 | Jewish |
| CFD_M-250-N.png | 36.2380952 | Jewish |
| IFD_M-069-N.png | 38.3571429 | Arab |
| IFD_M-028-N.png | 40.6190476 | Jewish |
| CFD_M-201-N.png | 40.9761905 | Jewish |
| IFD_M-423-N.png | 41.7380952 | Arab |
| IFD_M-107-N.png | 47.4047619 | Arab |
| CFD_M-202-N.png | 49.4047619 | Arab |
| IFD_M-066-N.png | 59.4047619 | Arab |
| IFD_M-039-N.png | 60.4047619 | Arab |
| IFD_M-045-N.png | 60.8095238 | Arab |
| IFD_M-046-N.png | 68.8333333 | Arab |
Code
saveRDS(data_images_10, file = "C:/Users/97252/Documents/GitHub/face_cater/PILOT- 1 face categorization/Data/final_data.rdx")Summary Table:
Code
summary_table_10 <- data_images_10 |>
count(rated_ethnicity) |>
spread(key = rated_ethnicity, value = n)
# Print the summary table
kable(summary_table_10, format = "html", table.attr = "style='width:50%;'", caption = "Summary of Rated Ethnicity")| Ambiguous | Arab | Jewish |
|---|---|---|
| 29 | 31 | 25 |
Difference of means per image by display with a cutoff of 15 points difference between the ratings
Code
data_images_15<- data_participants_without_all |>
group_by(image, Participant_Private_ID) |>
#dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))|>
dplyr::summarize(
task_Jewish = mean(Response[display == "task_Jewish"], na.rm = TRUE),
task_Arab = mean(Response[display == "task_Arab"], na.rm = TRUE),
.groups = 'drop' ) |> # Calculate the difference in ratings for each participant and image
mutate(diff_per_participant = task_Jewish - task_Arab) |>
# Aggregate at the image level
group_by(image) |>
dplyr::summarize(
avg_diff = mean(diff_per_participant, na.rm = TRUE),
.groups = 'drop') |># Classify based on the average difference
mutate(
rated_ethnicity = case_when(
avg_diff < -15 ~ "Arab",
avg_diff > 15 ~ "Jewish",
TRUE ~ "Ambiguous"
)
)|>
mutate(avg_diff = abs(avg_diff)) |>
arrange(avg_diff)
data_images_big_diff_15 <- data_images_15 |>
dplyr::filter(abs(avg_diff) >= 15) |>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
data_images_choosen_15 <- data_images_15 |>
dplyr::filter(abs(avg_diff)<15)|>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
kable(data_images_15, caption = "Difference of means with a cutoff of 15 points")| image | avg_diff | rated_ethnicity |
|---|---|---|
| CFD_M-242-N.png | 0.4047619 | Ambiguous |
| CFD_M-212-N.png | 0.5476190 | Ambiguous |
| IFD_M-419-N.png | 0.5714286 | Ambiguous |
| CFD_M-236-N.png | 1.2380952 | Ambiguous |
| CFD_M-220-N.png | 1.3809524 | Ambiguous |
| CFD_M-234-N.png | 1.5000000 | Ambiguous |
| CFD_M-206-N.png | 1.8809524 | Ambiguous |
| IFD_M-018-N.png | 2.1904762 | Ambiguous |
| CFD_M-227-N.png | 2.2142857 | Ambiguous |
| CFD_M-224-N.png | 2.8571429 | Ambiguous |
| CFD_M-218-N.png | 4.0952381 | Ambiguous |
| CFD_M-211-N.png | 4.9761905 | Ambiguous |
| IFD_M-108-N.png | 5.1666667 | Ambiguous |
| CFD_M-214-N.png | 5.3809524 | Ambiguous |
| IFD_M-135-N.png | 5.3809524 | Ambiguous |
| IFD_M-416-N.png | 5.8095238 | Ambiguous |
| IFD_M-105-N.png | 6.2142857 | Ambiguous |
| CFD_M-237-N.png | 6.3095238 | Ambiguous |
| CFD_M-216-N.png | 6.5000000 | Ambiguous |
| CFD_M-248-N.png | 6.8571429 | Ambiguous |
| CFD_M-243-N.png | 7.0238095 | Ambiguous |
| CFD_M-229-N.png | 7.3571429 | Ambiguous |
| IFD_M-086-N.png | 7.5476190 | Ambiguous |
| CFD_M-247-N.png | 7.5714286 | Ambiguous |
| IFD_M-067-N.png | 7.9761905 | Ambiguous |
| CFD_M-253-N.png | 8.2380952 | Ambiguous |
| IFD_M-424-N.png | 9.8095238 | Ambiguous |
| CFD_M-225-N.png | 9.8809524 | Ambiguous |
| IFD_M-132-N.png | 9.9523810 | Ambiguous |
| IFD_M-421-N.png | 10.0476190 | Ambiguous |
| IFD_M-136-N.png | 12.8809524 | Ambiguous |
| IFD_M-420-N.png | 14.2619048 | Ambiguous |
| CFD_M-213-N.png | 14.4047619 | Ambiguous |
| IFD_M-117-N.png | 14.5952381 | Ambiguous |
| CFD_M-231-N.png | 14.7857143 | Ambiguous |
| CFD_M-222-N.png | 15.4047619 | Jewish |
| IFD_M-062-N.png | 15.4285714 | Arab |
| CFD_M-223-N.png | 15.6666667 | Arab |
| CFD_M-246-N.png | 16.1428571 | Arab |
| IFD_M-075-N.png | 16.7142857 | Arab |
| CFD_M-230-N.png | 16.8333333 | Arab |
| IFD_M-121-N.png | 16.8571429 | Jewish |
| IFD_M-036-N.png | 16.8809524 | Jewish |
| CFD_M-204-N.png | 16.9761905 | Jewish |
| IFD_M-100-N.png | 18.4285714 | Jewish |
| CFD_M-251-N.png | 18.6428571 | Jewish |
| IFD_M-042-N.png | 18.8809524 | Arab |
| IFD_M-122-N.png | 19.1190476 | Jewish |
| CFD_M-200-N.png | 19.3333333 | Jewish |
| CFD_M-221-N.png | 19.5952381 | Jewish |
| IFD_M-044-N.png | 19.6666667 | Arab |
| CFD_M-252-N.png | 20.0238095 | Arab |
| CFD_M-239-N.png | 20.2380952 | Arab |
| IFD_M-033-N.png | 21.1904762 | Jewish |
| IFD_M-418-N.png | 21.5238095 | Jewish |
| IFD_M-441-N.png | 22.7619048 | Jewish |
| IFD_M-021-N.png | 22.8095238 | Jewish |
| IFD_M-051-N.png | 23.1190476 | Arab |
| IFD_M-111-N.png | 23.1190476 | Arab |
| CFD_M-210-N.png | 23.2142857 | Arab |
| IFD_M-087-N.png | 24.5238095 | Jewish |
| CFD_M-238-N.png | 24.8571429 | Arab |
| IFD_M-015-N.png | 25.1190476 | Jewish |
| IFD_M-113-N.png | 25.9047619 | Jewish |
| IFD_M-084-N.png | 26.2142857 | Arab |
| CFD_M-232-N.png | 26.7857143 | Arab |
| IFD_M-097-N.png | 27.3571429 | Arab |
| IFD_M-032-N.png | 27.4285714 | Arab |
| IFD_M-020-N.png | 28.1666667 | Arab |
| IFD_M-035-N.png | 28.9285714 | Jewish |
| CFD_M-235-N.png | 29.5238095 | Arab |
| IFD_M-049-N.png | 29.8095238 | Arab |
| IFD_M-017-N.png | 33.7857143 | Jewish |
| IFD_M-114-N.png | 34.0714286 | Jewish |
| CFD_M-250-N.png | 36.2380952 | Jewish |
| IFD_M-069-N.png | 38.3571429 | Arab |
| IFD_M-028-N.png | 40.6190476 | Jewish |
| CFD_M-201-N.png | 40.9761905 | Jewish |
| IFD_M-423-N.png | 41.7380952 | Arab |
| IFD_M-107-N.png | 47.4047619 | Arab |
| CFD_M-202-N.png | 49.4047619 | Arab |
| IFD_M-066-N.png | 59.4047619 | Arab |
| IFD_M-039-N.png | 60.4047619 | Arab |
| IFD_M-045-N.png | 60.8095238 | Arab |
| IFD_M-046-N.png | 68.8333333 | Arab |
Code
saveRDS(data_images_15, file = "C:/Users/97252/Documents/GitHub/face_cater/PILOT- 1 face categorization/Data/final_data.rdx")Summary Table:
Code
summary_table_15 <- data_images_15 |>
count(rated_ethnicity) |>
spread(key = rated_ethnicity, value = n)
# Print the summary table
kable(summary_table_15, format = "html", table.attr = "style='width:50%;'", caption = "Summary of Rated Ethnicity")| Ambiguous | Arab | Jewish |
|---|---|---|
| 35 | 28 | 22 |
Difference of means per image by display with a cutoff of 20 points difference between the ratings
Code
data_images_20<- data_participants_without_all |>
group_by(image, Participant_Private_ID) |>
#dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))|>
dplyr::summarize(
task_Jewish = mean(Response[display == "task_Jewish"], na.rm = TRUE),
task_Arab = mean(Response[display == "task_Arab"], na.rm = TRUE),
.groups = 'drop' ) |> # Calculate the difference in ratings for each participant and image
mutate(diff_per_participant = task_Jewish - task_Arab) |>
# Aggregate at the image level
group_by(image) |>
dplyr::summarize(
avg_diff = mean(diff_per_participant, na.rm = TRUE),
.groups = 'drop') |># Classify based on the average difference
mutate(
rated_ethnicity = case_when(
avg_diff < -20 ~ "Arab",
avg_diff > 20 ~ "Jewish",
TRUE ~ "Ambiguous"
)
)|>
mutate(avg_diff = abs(avg_diff)) |>
arrange(avg_diff)
data_images_big_diff_20 <- data_images_20 |>
dplyr::filter(abs(avg_diff) >= 20) |>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
data_images_choosen_20 <- data_images_20 |>
dplyr::filter(abs(avg_diff)<20)|>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
kable(data_images_20, caption = "Difference of means with a cutoff of 20 points")| image | avg_diff | rated_ethnicity |
|---|---|---|
| CFD_M-242-N.png | 0.4047619 | Ambiguous |
| CFD_M-212-N.png | 0.5476190 | Ambiguous |
| IFD_M-419-N.png | 0.5714286 | Ambiguous |
| CFD_M-236-N.png | 1.2380952 | Ambiguous |
| CFD_M-220-N.png | 1.3809524 | Ambiguous |
| CFD_M-234-N.png | 1.5000000 | Ambiguous |
| CFD_M-206-N.png | 1.8809524 | Ambiguous |
| IFD_M-018-N.png | 2.1904762 | Ambiguous |
| CFD_M-227-N.png | 2.2142857 | Ambiguous |
| CFD_M-224-N.png | 2.8571429 | Ambiguous |
| CFD_M-218-N.png | 4.0952381 | Ambiguous |
| CFD_M-211-N.png | 4.9761905 | Ambiguous |
| IFD_M-108-N.png | 5.1666667 | Ambiguous |
| CFD_M-214-N.png | 5.3809524 | Ambiguous |
| IFD_M-135-N.png | 5.3809524 | Ambiguous |
| IFD_M-416-N.png | 5.8095238 | Ambiguous |
| IFD_M-105-N.png | 6.2142857 | Ambiguous |
| CFD_M-237-N.png | 6.3095238 | Ambiguous |
| CFD_M-216-N.png | 6.5000000 | Ambiguous |
| CFD_M-248-N.png | 6.8571429 | Ambiguous |
| CFD_M-243-N.png | 7.0238095 | Ambiguous |
| CFD_M-229-N.png | 7.3571429 | Ambiguous |
| IFD_M-086-N.png | 7.5476190 | Ambiguous |
| CFD_M-247-N.png | 7.5714286 | Ambiguous |
| IFD_M-067-N.png | 7.9761905 | Ambiguous |
| CFD_M-253-N.png | 8.2380952 | Ambiguous |
| IFD_M-424-N.png | 9.8095238 | Ambiguous |
| CFD_M-225-N.png | 9.8809524 | Ambiguous |
| IFD_M-132-N.png | 9.9523810 | Ambiguous |
| IFD_M-421-N.png | 10.0476190 | Ambiguous |
| IFD_M-136-N.png | 12.8809524 | Ambiguous |
| IFD_M-420-N.png | 14.2619048 | Ambiguous |
| CFD_M-213-N.png | 14.4047619 | Ambiguous |
| IFD_M-117-N.png | 14.5952381 | Ambiguous |
| CFD_M-231-N.png | 14.7857143 | Ambiguous |
| CFD_M-222-N.png | 15.4047619 | Ambiguous |
| IFD_M-062-N.png | 15.4285714 | Ambiguous |
| CFD_M-223-N.png | 15.6666667 | Ambiguous |
| CFD_M-246-N.png | 16.1428571 | Ambiguous |
| IFD_M-075-N.png | 16.7142857 | Ambiguous |
| CFD_M-230-N.png | 16.8333333 | Ambiguous |
| IFD_M-121-N.png | 16.8571429 | Ambiguous |
| IFD_M-036-N.png | 16.8809524 | Ambiguous |
| CFD_M-204-N.png | 16.9761905 | Ambiguous |
| IFD_M-100-N.png | 18.4285714 | Ambiguous |
| CFD_M-251-N.png | 18.6428571 | Ambiguous |
| IFD_M-042-N.png | 18.8809524 | Ambiguous |
| IFD_M-122-N.png | 19.1190476 | Ambiguous |
| CFD_M-200-N.png | 19.3333333 | Ambiguous |
| CFD_M-221-N.png | 19.5952381 | Ambiguous |
| IFD_M-044-N.png | 19.6666667 | Ambiguous |
| CFD_M-252-N.png | 20.0238095 | Arab |
| CFD_M-239-N.png | 20.2380952 | Arab |
| IFD_M-033-N.png | 21.1904762 | Jewish |
| IFD_M-418-N.png | 21.5238095 | Jewish |
| IFD_M-441-N.png | 22.7619048 | Jewish |
| IFD_M-021-N.png | 22.8095238 | Jewish |
| IFD_M-051-N.png | 23.1190476 | Arab |
| IFD_M-111-N.png | 23.1190476 | Arab |
| CFD_M-210-N.png | 23.2142857 | Arab |
| IFD_M-087-N.png | 24.5238095 | Jewish |
| CFD_M-238-N.png | 24.8571429 | Arab |
| IFD_M-015-N.png | 25.1190476 | Jewish |
| IFD_M-113-N.png | 25.9047619 | Jewish |
| IFD_M-084-N.png | 26.2142857 | Arab |
| CFD_M-232-N.png | 26.7857143 | Arab |
| IFD_M-097-N.png | 27.3571429 | Arab |
| IFD_M-032-N.png | 27.4285714 | Arab |
| IFD_M-020-N.png | 28.1666667 | Arab |
| IFD_M-035-N.png | 28.9285714 | Jewish |
| CFD_M-235-N.png | 29.5238095 | Arab |
| IFD_M-049-N.png | 29.8095238 | Arab |
| IFD_M-017-N.png | 33.7857143 | Jewish |
| IFD_M-114-N.png | 34.0714286 | Jewish |
| CFD_M-250-N.png | 36.2380952 | Jewish |
| IFD_M-069-N.png | 38.3571429 | Arab |
| IFD_M-028-N.png | 40.6190476 | Jewish |
| CFD_M-201-N.png | 40.9761905 | Jewish |
| IFD_M-423-N.png | 41.7380952 | Arab |
| IFD_M-107-N.png | 47.4047619 | Arab |
| CFD_M-202-N.png | 49.4047619 | Arab |
| IFD_M-066-N.png | 59.4047619 | Arab |
| IFD_M-039-N.png | 60.4047619 | Arab |
| IFD_M-045-N.png | 60.8095238 | Arab |
| IFD_M-046-N.png | 68.8333333 | Arab |
Code
saveRDS(data_images_20, file = "C:/Users/97252/Documents/GitHub/face_cater/PILOT- 1 face categorization/Data/final_data.rdx")Summary Table:
Code
summary_table_20 <- data_images_20 |>
count(rated_ethnicity) |>
spread(key = rated_ethnicity, value = n)
# Print the summary table
kable(summary_table_20, format = "html", table.attr = "style='width:50%;'", caption = "Summary of Rated Ethnicity")| Ambiguous | Arab | Jewish |
|---|---|---|
| 51 | 21 | 13 |
Difference of means per image by display without outlires and particular participants
- Analyze the main task by calculating and comparing mean responses for different image categories.
- Identify significant differences in means and categorize images based on these differences.
Visualization with ggplot2:
Responses and overall trends per image by display
Visualizing image ratings in both display forms.
Code
plot_images <- data_participants_without_all |>
group_by(display, image) |>
mutate(per_condition_mean = mean(Response, na.rm = T)) |>
#filter(str_detect(image, pattern = "20")) |>
ggplot(aes(x = display, y = Response)) +
geom_point() +
geom_point(aes(y = per_condition_mean, color = "red"), show.legend = F) +
facet_wrap(~image, scales = "fixed") +
scale_y_continuous(labels = seq(0, 100, 10), breaks = seq(0, 100, 10)) +
theme(axis.text.x = element_text(angle = 90, vjust = .5, hjust = 1)) +
theme_classic()
ggsave("plot_images_without_all.png", plot = plot_images, path = "../Plots_outliers/", width = 4000, height = 4000, units = "px")
Responses and overall trends per image by display and Order of conditions
Code
data_participants <- data_participants_without_all |>
group_by(display, image, order_of_conditions) |>
mutate(per_condition_mean = mean(Response, na.rm = TRUE)) |>
ungroup()
plot_image_condition <- data_participants |>
mutate(order = case_when(display == "task_Arab" & order_of_conditions == "ArabFirst" ~ "First",
display == "task_Jewish" & order_of_conditions == "JewishFirst" ~ "First",
.default = "Second")) |>
ggplot(aes(y = Response, x = order, fill = display)) +
geom_violin(position = "dodge", color = "gray34") +
geom_point(aes(y = per_condition_mean), position = position_dodge(.9), color = "red", show.legend = F) +
facet_wrap(~image)
# Save the modified plot
ggsave("plot_images_order_condition_separated.png", plot = plot_image_condition,path = "../Plots_outliers/", width = 40, height = 40, units = "cm", bg = "white", limitsize = FALSE)
Code
# Ensure the data is grouped and then summarize
data_wide <- data_participants_without_all |>
group_by(image, display) |>
dplyr::summarize(mean_response = mean(Response, na.rm = TRUE), .groups = 'drop')
# Reshaping the data to wide format
data_wide <- data_wide |>
pivot_wider(names_from = display, values_from = mean_response)
# Calculating the difference
data_diff <- data_wide |>
mutate(diff = abs(`task_Arab` - `task_Jewish`), # Replace with your actual display column names
diff_less_than_22 = ifelse(diff < 10, "same", "no_same"))
# Merging the difference back into the original data
data_participants1 <- data_participants_without_all |>
left_join(data_diff, by = "image")
data_participants1 <- data_participants1 |>
group_by(image, display) |>
mutate(per_condition_mean = mean(Response, na.rm = TRUE)) |>
ungroup()
# Creating the plot
plot1 <- data_participants1 |>
ggplot(aes(x = display, y = Response, color = diff_less_than_22)) +
geom_point() +
geom_point(aes(y = per_condition_mean, color = "mean"), show.legend = F) +
facet_wrap(~image, scales = "fixed") +
scale_y_continuous(labels = seq(0, 100, 10), breaks = seq(0, 100, 10)) +
theme(axis.text.x = element_text(angle = 90, vjust = .5, hjust = 1)) +
theme_classic() +
scale_color_manual(values = c("same" = "#E84646", "no_same" = "black", "mean" = "#7B8FD4"))
# Display the plot
ggsave("plot1_without_all.png", plot = plot1, path = "../Plots_outliers/", width = 4000, height = 4000, units = "px")
Participants ratings- individual participant responses and overall trends
Code
participant_conditions <- data_participants_without_all |>
distinct(Participant_Private_ID, order_of_conditions) |>
mutate(label = paste(Participant_Private_ID, ifelse(order_of_conditions == "JewishFirst", "Jewish first", "Arab first")))
plot_participants_condLabel <- data_participants_without_all |>
group_by(Participant_Private_ID, display) |>
mutate(participant_mean = mean(Response, na.rm = TRUE)) |>
ggplot(aes(x = display, y = Response)) +
geom_point() +
geom_point(aes(y = participant_mean, color = "red"), show.legend = FALSE) + # Highlighting participant mean
facet_wrap(~Participant_Private_ID, labeller = as_labeller(setNames(participant_conditions$label, participant_conditions$Participant_Private_ID))) +
scale_x_discrete(labels = c("Arab" = "Arab", "Jewish" = "Jewish")) +
scale_y_continuous(breaks = seq(0, 100, 10), labels = seq(0, 100, 10)) +
labs(x = "") +
theme_classic()
ggsave("plot_participants_without_all_label.png", plot = plot_participants_condLabel, path = "../Plots_outliers/", width = 4000, height = 4000, units = "px")
Adding lines that connects between the ratings of each image:
Code
plot_participants_with_line <- data_participants_without_all |>
ggplot(aes(x = display, y = Response)) +
geom_smooth(aes(x = display, y = Response, group = image), method = "lm", color = "gray84", se = F, inherit.aes = F) +
geom_smooth(aes(group = -1), method = "lm", se = F, color = "red") +
facet_wrap(~Participant_Private_ID) +
scale_y_continuous(limits = c(0, 100)) +
theme_classic()
ggsave("plot_line_participants_without_All.png", plot = plot_participants_with_line, path = "../Plots_outliers/", width = 4000, height = 4000, units = "px")
Demographics
Data_set arrangment
- Import and clean demographic data.
- Perform necessary transformations and renamings of demographic variables.
- Generate summary statistics and visualizations for demographic variables such as age, gender, religiosity, education, and socio-economic status.
Code
data_demo <- data_demo |>
colnames_to_underscores() |>
dplyr::filter(!(Question_Key %in% c("BEGIN QUESTIONNAIRE", "END QUESTIONNAIRE"))) |>
dplyr::filter(Event_Index != "END OF FILE") |>
select(Participant_Private_ID, Question_Key, Response) |>
pivot_wider(names_from = Question_Key, values_from = Response)
#data_demo$gender[3] <- "אישה"Code
demo_wide_clean <- data_demo |>
mutate(gender = case_when(`gender-quantised` == "1" ~ "man",
`gender-quantised` == "2" ~ "woman")) |>
select(-`gender-quantised`, -`gender-quantised`, -`gender-text`, -`ethnic-text`, -`religiosity-quantised`, -`scale_of_SES-quantised`, -`age-quantised`) |>
mutate(Participant_Private_ID = factor(Participant_Private_ID),
age = as.numeric(age),
children = as.numeric(children),
scale_of_SES = as.numeric(scale_of_SES))
# demo_wide_clean$`ethnic-1`[3] <- "ישראלי/ת"
# demo_wide_clean$`ethnic-4` <- "יהודי/ת"
# demo_wide_clean$education[3] <- " למדתי לימודים מתקדמים מעבר לתואר ראשון"Rename columns
Code
demo_wide_clean <- demo_wide_clean |>
rename(ethnic = `ethnic-1`, SES = scale_of_SES, comment = `response-7`, ethnic2 = `ethnic-4`, )separatlly visualizations and summary statistics for demographic variables
Age
Code
ggplot(demo_wide_clean, aes(x = age)) +
geom_histogram(bins = 50) +
scale_x_continuous(breaks = seq(17, 71, 2)) +
theme_classic()
Summary Table for AGE stat:
Code
Age_stats <- get_summary_stats(as.data.frame(as.numeric(demo_wide_clean$age)))
if (!requireNamespace("knitr", quietly = TRUE)) {
install.packages("knitr")
}
library(knitr)
# Generate a nice table using kable
kable(Age_stats, caption = "Summary Statistics for Age", format = "markdown")| as.numeric(demo_wide_clean$age) | |
|---|---|
| Min. :18.00 | |
| 1st Qu.:23.00 | |
| Median :30.00 | |
| Mean :29.49 | |
| 3rd Qu.:33.00 | |
| Max. :72.00 | |
| NA’s :2 |
Code
Age_stats_df <- data.frame(
Statistic = c("Mean", "Median", "SD", "Min", "Max"),
Value = c(mean(demo_wide_clean$age, na.rm = TRUE),
median(demo_wide_clean$age, na.rm = TRUE),
sd(demo_wide_clean$age, na.rm = TRUE),
min(demo_wide_clean$age, na.rm = TRUE),
max(demo_wide_clean$age, na.rm = TRUE))
)
kable(Age_stats_df, caption = "Summary Statistics for Age", format = "markdown")| Statistic | Value |
|---|---|
| Mean | 29.4898 |
| Median | 30.0000 |
| SD | 10.2533 |
| Min | 18.0000 |
| Max | 72.0000 |
Gender
Code
ggplot(demo_wide_clean, aes(x = gender)) +
geom_histogram(stat = "count") +
scale_y_continuous(breaks = seq(0, 200, 10)) +
theme_classic()
Code
male_per <- sum(demo_wide_clean$gender == "man", na.rm = TRUE) /
sum(!is.na(demo_wide_clean$gender))
female_per <- sum(demo_wide_clean$gender == "woman", na.rm = T) /
sum(!is.na(demo_wide_clean$gender))
a_baniari_per <- sum(demo_wide_clean$gender == "לא בינארי", na.rm = T)/
sum(!is.na(demo_wide_clean$gender))Religiosity
Code
ggplot(demo_wide_clean, aes(x = religiosity)) +
geom_histogram(stat = "count") +
scale_y_continuous(breaks = seq(0, 200, 10)) +
theme_classic()
Summary Table for Religiosity stat:
Code
religiosity_stats <- get_summary_stats(as.data.frame(as.numeric(demo_wide_clean$religiosity)))
Age_stats <- get_summary_stats(as.data.frame(as.numeric(demo_wide_clean$age)))
if (!requireNamespace("knitr", quietly = TRUE)) {
install.packages("knitr")
}
library(knitr)
str(demo_wide_clean)tibble [51 × 16] (S3: tbl_df/tbl/data.frame)
$ Participant_Private_ID: Factor w/ 51 levels "10514858","10515072",..: 1 2 3 4 5 6 7 8 9 10 ...
$ age : num [1:51] 19 72 22 19 27 22 19 26 27 29 ...
$ gender : chr [1:51] "man" "man" "man" "woman" ...
$ ethnic : chr [1:51] "ישראלי/ת" "ישראלי/ת" NA "ישראלי/ת" ...
$ ethnic2 : chr [1:51] "יהודי/ת" "יהודי/ת" NA "יהודי/ת" ...
$ ethnic-8 : chr [1:51] "חרד/ית" NA "חרד/ית" NA ...
$ religiosity : chr [1:51] "9" "3" "8" "1" ...
$ education : chr [1:51] "למדתי לימודים מתקדמים מעבר לתואר ראשון" "השלמתי תואר ראשון באוניברסיטה" "השלמתי בית ספר יסודי" "השלמתי בית ספר תיכון" ...
$ education-quantised : chr [1:51] "7" "6" "2" "4" ...
$ language : chr [1:51] "כן" "כן" "כן" "כן" ...
$ language -quantised : chr [1:51] "1" "1" "1" "1" ...
$ vision : chr [1:51] "ראייה מתוקנת (משקפיים/עדשות)" "ראייה מתוקנת (משקפיים/עדשות)" "ראייה מתוקנת (משקפיים/עדשות)" "כן" ...
$ vision-quantised : chr [1:51] "2" "2" "2" "1" ...
$ children : num [1:51] 1 2 1 0 0 0 0 0 0 3 ...
$ SES : num [1:51] 6 8 5 6 6 7 7 5 6 4 ...
$ comment : chr [1:51] NA NA NA NA ...Code
demo_wide_clean$religiosity <- as.numeric(as.character(demo_wide_clean$religiosity))
# Generate a nice table using kable
kable(religiosity_stats, caption = "Summary Statistics for religiosity", format = "markdown")| as.numeric(demo_wide_clean$religiosity) | |
|---|---|
| Min. : 1.000 | |
| 1st Qu.: 3.000 | |
| Median : 6.000 | |
| Mean : 5.588 | |
| 3rd Qu.: 8.000 | |
| Max. :10.000 |
Code
relig_stats_df <- data.frame(
Statistic = c("Mean", "Median", "SD", "Min", "Max"),
Value = c(mean(demo_wide_clean$religiosity, na.rm = TRUE),
median(demo_wide_clean$religiosity, na.rm = TRUE),
sd(demo_wide_clean$religiosity, na.rm = TRUE),
min(demo_wide_clean$religiosity, na.rm = TRUE),
max(demo_wide_clean$religiosity, na.rm = TRUE))
)
kable(relig_stats_df, caption = "Summary Statistics for Religiosity", format = "markdown")| Statistic | Value |
|---|---|
| Mean | 5.588235 |
| Median | 6.000000 |
| SD | 3.093066 |
| Min | 1.000000 |
| Max | 10.000000 |
Code
demo_table <- flextable::summarizor(demo_wide_clean[,-1], overall_label = "overall") |>
flextable::as_flextable(sep_w = 0, spread_first_col = T)Education
Code
education_levels <- c('1' = 'Part of Primary School', '2' = 'Finished Primary School', '3' = 'Part of High School', '4' = 'Finished High School', '5' = 'In Bachelor\'s Degree', '6' = 'Finished Bachelor\'s Degree', '7' = 'Master\'s Degree', '8' = 'Prefer not to answer')
demo_wide_clean$education <- factor(demo_wide_clean$`education-quantised`, levels = c('1', '2', '3', '4', '5', '6', '7', '8'), labels = c('Part of Primary School', 'Finished Primary School', 'Part of High School', 'Finished High School', 'In Bachelor\'s Degree', 'Finished Bachelor\'s Degree', 'Master\'s Degree', 'Prefer not to answer'))
ggplot(demo_wide_clean, aes(x = education)) +
geom_bar() +
scale_y_continuous(breaks = seq(0, 200, 10)) +
theme_classic() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
SES
Code
ggplot(drop_na(demo_wide_clean, SES), aes(x = SES)) +
geom_histogram(stat = "count", binwidth = 1) +
stat_bin(binwidth = 1, geom = 'text', color = 'white', aes(label = after_stat(count)),
position = position_stack(vjust = 0.5)) +
scale_x_continuous(breaks = c(1:10)) +
scale_y_continuous(breaks = seq(0, 160, 10)) +
labs(title = "On a scale of 1-10 how would you rate your Social-Economic status?",
subtitle = "1 = Lowest status, 10 = Highest status",
y = "Number of participants",
x = "") +
theme_classic() +
theme(plot.title = element_text(family = "serif", hjust = 0.5, size = 16),
plot.subtitle = element_text(family = "serif", hjust = 0.5, size = 10))
Summary Table for SES stat:
Code
SES_stats <- get_summary_stats(as.data.frame(as.numeric(demo_wide_clean$SES)))
# Generate a nice table using kable
kable(SES_stats, caption = "Summary Statistics for SES", format = "markdown")| as.numeric(demo_wide_clean$SES) | |
|---|---|
| Min. :2.000 | |
| 1st Qu.:5.000 | |
| Median :6.000 | |
| Mean :5.824 | |
| 3rd Qu.:7.000 | |
| Max. :8.000 |
Code
SES_stats_df <- data.frame(
Statistic = c("Mean", "Median", "SD", "Min", "Max"),
Value = c(mean(demo_wide_clean$SES, na.rm = TRUE),
median(demo_wide_clean$SES, na.rm = TRUE),
sd(demo_wide_clean$SES, na.rm = TRUE),
min(demo_wide_clean$SES, na.rm = TRUE),
max(demo_wide_clean$SES, na.rm = TRUE))
)
# Now generate the table with kable
kable(SES_stats_df, caption = "Summary Statistics for SES", format = "markdown")| Statistic | Value |
|---|---|
| Mean | 5.823529 |
| Median | 6.000000 |
| SD | 1.260252 |
| Min | 2.000000 |
| Max | 8.000000 |
Same Analysis, when calculating only the first rating
Adding a new column to identify the initial responses, those presented during the first condition only.
Code
data_participants_order <- data_participants_without_all |>
mutate(order = case_when(
display == "task_Arab" & order_of_conditions == "ArabFirst" ~ "First",
display == "task_Jewish" & order_of_conditions == "JewishFirst" ~ "First",
TRUE ~ "Second" # Note the change here from '.default' to 'TRUE'
))
data_participants_first_only <- data_participants_order |>
filter(order == "First")Code
# same but with outliers
density_plot_first <- ggplot(data_participants_first_only, aes(x = Response, fill = display)) +
geom_density(alpha = 0.5) + # Plot density
geom_rug(aes(color = display), sides = "b") + # Add rug plot at the bottom
scale_fill_brewer(palette = "Pastel1") + # Use Pastel1 palette for fill
scale_color_brewer(palette = "Pastel1") + # Use Pastel1 palette for rug and mean line colors
theme_minimal() +
labs(title = "Density of Ratings by Display", x = "Rating", y = "Density") +
geom_vline(data = data_participants_first_only %>% group_by(display) |>
summarise(mean_response = mean(Response, na.rm = TRUE)),
aes(xintercept = mean_response),
linetype = "dashed", color = "black", size = 0.5)
ggsave("density_plot_only_first.png", density_plot_first, path = "../Plots_first/", width = 10, height = 8, units = "in", bg = "white")SD table
A table showing the average standard deviation of each subject’s ratings beyond display types
Code
participant_sd_ratings_first <- data_participants_first_only |>
group_by(Participant_Private_ID) |>
summarise(SD_of_Ratings = sd(Response, na.rm = TRUE)) |>
ungroup()
kable(participant_sd_ratings_first, caption = "Standard Deviation of Ratings for Each Participant")| Participant_Private_ID | SD_of_Ratings |
|---|---|
| 10514858 | 21.82392 |
| 10515072 | 39.10622 |
| 10515173 | 23.01336 |
| 10515193 | 34.72058 |
| 10515201 | 36.20395 |
| 10515243 | 38.63941 |
| 10515319 | 33.84229 |
| 10515327 | 32.60062 |
| 10515918 | 18.02723 |
| 10515942 | 11.03608 |
| 10515960 | 21.52988 |
| 10515998 | 27.79639 |
| 10516258 | 25.53825 |
| 10516270 | 26.95892 |
| 10516302 | 23.18782 |
| 10516415 | 33.76182 |
| 10516645 | 19.74638 |
| 10516756 | 22.65539 |
| 10517522 | 20.80531 |
| 10517752 | 34.25632 |
| 10517925 | 38.87596 |
| 10518377 | 21.29545 |
| 10519057 | 30.84461 |
| 10519217 | 10.66527 |
| 10519319 | 32.69611 |
| 10519805 | 31.46824 |
| 10520066 | 17.28570 |
| 10520207 | 35.05864 |
| 10520244 | 27.08428 |
| 10520416 | 32.32034 |
| 10520443 | 24.22102 |
| 10520738 | 25.76987 |
| 10522475 | 24.71253 |
| 10522511 | 19.34941 |
| 10522561 | 25.75767 |
| 10527960 | 31.73418 |
| 10528402 | 14.74900 |
| 10528576 | 28.43895 |
| 10530076 | 36.29174 |
| 10530576 | 19.68271 |
| 10530858 | 31.83919 |
| 10531834 | 22.11642 |
Main task
A Betwwen subjects Analysis: Difference of means per image by display with a cutoff of 10 points difference between the ratings
- Analyze the main task by calculating and comparing mean responses for different image categories.
- Identify significant differences in means and categorize images based on these differences.
Code
data_images_comparison_10 <- data_participants_first_only |>
group_by(image, display) |>
summarize(average_rating = mean(Response, na.rm = TRUE), .groups = 'drop') |>
spread(key = display, value = average_rating) |>
mutate(avg_diff = `task_Jewish` - `task_Arab`) |>
mutate(rated_ethnicity = case_when(
avg_diff < -10 ~ "Arab",
avg_diff > 10 ~ "Jewish",
TRUE ~ "Ambiguous"
)) |>
mutate(avg_diff = abs(avg_diff)) |>
arrange(avg_diff)
data_images_big_diff_10_first <- data_images_comparison_10 |>
dplyr::filter(abs(avg_diff) >= 10) |>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
data_images_choosen_10_first <- data_images_comparison_10 |>
dplyr::filter(abs(avg_diff)<10)|>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
kable(data_images_comparison_10, caption = "Difference of means with a cutoff of 10 points")| image | task_Arab | task_Jewish | avg_diff | rated_ethnicity |
|---|---|---|---|---|
| CFD_M-220-N.png | 26.86364 | 26.90 | 0.0363636 | Ambiguous |
| CFD_M-242-N.png | 21.63636 | 21.90 | 0.2636364 | Ambiguous |
| IFD_M-018-N.png | 48.40909 | 47.60 | 0.8090909 | Ambiguous |
| IFD_M-416-N.png | 55.77273 | 54.95 | 0.8227273 | Ambiguous |
| CFD_M-236-N.png | 45.09091 | 43.70 | 1.3909091 | Ambiguous |
| CFD_M-227-N.png | 26.81818 | 28.60 | 1.7818182 | Ambiguous |
| CFD_M-211-N.png | 29.18182 | 31.05 | 1.8681818 | Ambiguous |
| IFD_M-419-N.png | 52.04545 | 54.00 | 1.9545455 | Ambiguous |
| IFD_M-135-N.png | 52.00000 | 55.30 | 3.3000000 | Ambiguous |
| CFD_M-206-N.png | 29.72727 | 25.90 | 3.8272727 | Ambiguous |
| CFD_M-225-N.png | 22.77273 | 18.50 | 4.2727273 | Ambiguous |
| CFD_M-224-N.png | 36.95455 | 41.30 | 4.3454545 | Ambiguous |
| CFD_M-218-N.png | 32.59091 | 27.95 | 4.6409091 | Ambiguous |
| CFD_M-212-N.png | 24.81818 | 29.80 | 4.9818182 | Ambiguous |
| CFD_M-243-N.png | 30.40909 | 25.35 | 5.0590909 | Ambiguous |
| CFD_M-216-N.png | 22.45455 | 16.25 | 6.2045455 | Ambiguous |
| CFD_M-213-N.png | 34.36364 | 28.00 | 6.3636364 | Ambiguous |
| IFD_M-067-N.png | 40.95455 | 34.50 | 6.4545455 | Ambiguous |
| CFD_M-223-N.png | 30.36364 | 23.80 | 6.5636364 | Ambiguous |
| CFD_M-248-N.png | 20.59091 | 27.90 | 7.3090909 | Ambiguous |
| CFD_M-229-N.png | 29.59091 | 22.10 | 7.4909091 | Ambiguous |
| IFD_M-105-N.png | 44.00000 | 53.55 | 9.5500000 | Ambiguous |
| CFD_M-237-N.png | 43.54545 | 33.85 | 9.6954545 | Ambiguous |
| IFD_M-424-N.png | 45.00000 | 34.65 | 10.3500000 | Arab |
| CFD_M-234-N.png | 18.54545 | 28.95 | 10.4045455 | Jewish |
| IFD_M-086-N.png | 30.72727 | 41.35 | 10.6227273 | Jewish |
| CFD_M-214-N.png | 15.90909 | 27.00 | 11.0909091 | Jewish |
| CFD_M-251-N.png | 25.54545 | 36.90 | 11.3545455 | Jewish |
| IFD_M-108-N.png | 56.59091 | 45.05 | 11.5409091 | Arab |
| IFD_M-418-N.png | 43.50000 | 55.35 | 11.8500000 | Jewish |
| CFD_M-247-N.png | 31.40909 | 19.50 | 11.9090909 | Arab |
| IFD_M-117-N.png | 35.36364 | 47.35 | 11.9863636 | Jewish |
| CFD_M-210-N.png | 41.95455 | 27.75 | 14.2045455 | Arab |
| IFD_M-421-N.png | 45.09091 | 59.30 | 14.2090909 | Jewish |
| IFD_M-075-N.png | 57.09091 | 41.90 | 15.1909091 | Arab |
| IFD_M-121-N.png | 37.72727 | 53.30 | 15.5727273 | Jewish |
| CFD_M-204-N.png | 36.04545 | 52.15 | 16.1045455 | Jewish |
| IFD_M-132-N.png | 46.31818 | 62.55 | 16.2318182 | Jewish |
| CFD_M-222-N.png | 17.40909 | 33.80 | 16.3909091 | Jewish |
| CFD_M-200-N.png | 19.40909 | 35.90 | 16.4909091 | Jewish |
| CFD_M-253-N.png | 21.22727 | 38.10 | 16.8727273 | Jewish |
| IFD_M-051-N.png | 57.09091 | 39.75 | 17.3409091 | Arab |
| CFD_M-221-N.png | 23.81818 | 41.75 | 17.9318182 | Jewish |
| CFD_M-246-N.png | 43.45455 | 24.30 | 19.1545455 | Arab |
| CFD_M-231-N.png | 19.77273 | 39.00 | 19.2272727 | Jewish |
| IFD_M-136-N.png | 63.40909 | 44.05 | 19.3590909 | Arab |
| IFD_M-033-N.png | 42.90909 | 62.35 | 19.4409091 | Jewish |
| IFD_M-062-N.png | 67.90909 | 47.35 | 20.5590909 | Arab |
| CFD_M-230-N.png | 54.81818 | 34.15 | 20.6681818 | Arab |
| IFD_M-420-N.png | 49.31818 | 27.80 | 21.5181818 | Arab |
| IFD_M-111-N.png | 66.77273 | 45.05 | 21.7227273 | Arab |
| IFD_M-042-N.png | 62.68182 | 40.80 | 21.8818182 | Arab |
| IFD_M-122-N.png | 40.81818 | 62.90 | 22.0818182 | Jewish |
| IFD_M-100-N.png | 41.54545 | 64.25 | 22.7045455 | Jewish |
| IFD_M-084-N.png | 60.36364 | 37.60 | 22.7636364 | Arab |
| IFD_M-087-N.png | 32.77273 | 55.55 | 22.7772727 | Jewish |
| CFD_M-239-N.png | 48.81818 | 25.70 | 23.1181818 | Arab |
| IFD_M-044-N.png | 60.00000 | 35.75 | 24.2500000 | Arab |
| CFD_M-235-N.png | 50.86364 | 26.25 | 24.6136364 | Arab |
| IFD_M-015-N.png | 32.77273 | 57.50 | 24.7272727 | Jewish |
| IFD_M-097-N.png | 65.09091 | 39.50 | 25.5909091 | Arab |
| IFD_M-036-N.png | 36.09091 | 62.50 | 26.4090909 | Jewish |
| IFD_M-021-N.png | 36.95455 | 64.65 | 27.6954545 | Jewish |
| IFD_M-113-N.png | 24.59091 | 52.85 | 28.2590909 | Jewish |
| CFD_M-232-N.png | 51.00000 | 21.95 | 29.0500000 | Arab |
| IFD_M-441-N.png | 28.72727 | 57.95 | 29.2227273 | Jewish |
| IFD_M-032-N.png | 64.13636 | 34.70 | 29.4363636 | Arab |
| IFD_M-035-N.png | 35.00000 | 65.50 | 30.5000000 | Jewish |
| CFD_M-250-N.png | 17.77273 | 48.45 | 30.6772727 | Jewish |
| CFD_M-252-N.png | 58.31818 | 27.30 | 31.0181818 | Arab |
| IFD_M-114-N.png | 23.31818 | 54.40 | 31.0818182 | Jewish |
| IFD_M-049-N.png | 73.59091 | 41.25 | 32.3409091 | Arab |
| CFD_M-238-N.png | 53.22727 | 19.95 | 33.2772727 | Arab |
| IFD_M-020-N.png | 65.81818 | 31.25 | 34.5681818 | Arab |
| IFD_M-017-N.png | 28.18182 | 64.75 | 36.5681818 | Jewish |
| CFD_M-201-N.png | 22.81818 | 62.95 | 40.1318182 | Jewish |
| IFD_M-069-N.png | 68.45455 | 27.50 | 40.9545455 | Arab |
| IFD_M-423-N.png | 68.22727 | 25.20 | 43.0272727 | Arab |
| IFD_M-028-N.png | 21.45455 | 65.05 | 43.5954545 | Jewish |
| CFD_M-202-N.png | 68.72727 | 15.35 | 53.3772727 | Arab |
| IFD_M-066-N.png | 85.40909 | 31.15 | 54.2590909 | Arab |
| IFD_M-107-N.png | 74.63636 | 19.95 | 54.6863636 | Arab |
| IFD_M-045-N.png | 84.95455 | 25.90 | 59.0545455 | Arab |
| IFD_M-039-N.png | 79.86364 | 18.00 | 61.8636364 | Arab |
| IFD_M-046-N.png | 84.31818 | 15.20 | 69.1181818 | Arab |
Code
saveRDS(data_images_10, file = "C:/Users/97252/Documents/GitHub/face_cater/PILOT- 1 face categorization/Data/final_data.rdx")Summary Table:
Code
summary_table_10 <- data_images_comparison_10 |>
count(rated_ethnicity) |>
spread(key = rated_ethnicity, value = n)
# Print the summary table
kable(summary_table_10, format = "html", table.attr = "style='width:50%;'", caption = "Summary of Rated Ethnicity")| Ambiguous | Arab | Jewish |
|---|---|---|
| 23 | 32 | 30 |
Comparing rating when taking into account all conditions VS only the first display:
Lets compare between the images when calculating the ratings based on all conditions VS when calculating only the first ratings:
Code
ambiguous_images_comparison_10 <- merge(data_images_10, data_images_comparison_10, by = "image", suffixes = c("_all", "_first"))
# Extracting 'Ambiguous' images from both datasets
ambiguous_images_all_10 = filter(data_images_10, rated_ethnicity == "Ambiguous")$image
ambiguous_images_first_10 = filter(data_images_comparison_10, rated_ethnicity == "Ambiguous")$image
# Finding common 'Ambiguous' images in both datasets
common_ambiguous_images_10 = intersect(ambiguous_images_all_10, ambiguous_images_first_10)
# Finding 'Ambiguous' images unique to the all conditions dataset
unique_ambiguous_all_10 = setdiff(ambiguous_images_all_10, ambiguous_images_first_10)
# Finding 'Ambiguous' images unique to the first ratings dataset
unique_ambiguous_first_10 = setdiff(ambiguous_images_first_10, ambiguous_images_all_10)
# Creating a summary table
summary_comparison_10 <- tibble(
Common_Ambiguous_10 = length(common_ambiguous_images_10),
Unique_Ambiguous_All_10 = length(unique_ambiguous_all_10),
Unique_Ambiguous_First_10 = length(unique_ambiguous_first_10)
)
# Display the summary
knitr::kable(summary_comparison_10,
caption = "Comparison of Ambiguous Images Across Different Conditions 10",
align = 'c')| Common_Ambiguous_10 | Unique_Ambiguous_All_10 | Unique_Ambiguous_First_10 |
|---|---|---|
| 21 | 8 | 2 |
Now let’s see the images id:
Code
common_ambiguous_images_df_10 <- tibble(Image = common_ambiguous_images_10, Category = "Common Ambiguous")
unique_ambiguous_all_df_10 <- tibble(Image = unique_ambiguous_all_10, Category = "Unique Ambiguous All")
unique_ambiguous_first_df_10 <- tibble(Image = unique_ambiguous_first_10, Category = "Unique Ambiguous First")
ambiguous_images_comparison_df_10 <- bind_rows(common_ambiguous_images_df_10, unique_ambiguous_all_df_10, unique_ambiguous_first_df_10)
# Display the comprehensive comparison
knitr::kable(ambiguous_images_comparison_df_10,
caption = "Comparison of Ambiguous Images Between All Conditions and First Ratings 10",
align = 'c')| Image | Category |
|---|---|
| CFD_M-242-N.png | Common Ambiguous |
| CFD_M-212-N.png | Common Ambiguous |
| IFD_M-419-N.png | Common Ambiguous |
| CFD_M-236-N.png | Common Ambiguous |
| CFD_M-220-N.png | Common Ambiguous |
| CFD_M-206-N.png | Common Ambiguous |
| IFD_M-018-N.png | Common Ambiguous |
| CFD_M-227-N.png | Common Ambiguous |
| CFD_M-224-N.png | Common Ambiguous |
| CFD_M-218-N.png | Common Ambiguous |
| CFD_M-211-N.png | Common Ambiguous |
| IFD_M-135-N.png | Common Ambiguous |
| IFD_M-416-N.png | Common Ambiguous |
| IFD_M-105-N.png | Common Ambiguous |
| CFD_M-237-N.png | Common Ambiguous |
| CFD_M-216-N.png | Common Ambiguous |
| CFD_M-248-N.png | Common Ambiguous |
| CFD_M-243-N.png | Common Ambiguous |
| CFD_M-229-N.png | Common Ambiguous |
| IFD_M-067-N.png | Common Ambiguous |
| CFD_M-225-N.png | Common Ambiguous |
| CFD_M-234-N.png | Unique Ambiguous All |
| IFD_M-108-N.png | Unique Ambiguous All |
| CFD_M-214-N.png | Unique Ambiguous All |
| IFD_M-086-N.png | Unique Ambiguous All |
| CFD_M-247-N.png | Unique Ambiguous All |
| CFD_M-253-N.png | Unique Ambiguous All |
| IFD_M-424-N.png | Unique Ambiguous All |
| IFD_M-132-N.png | Unique Ambiguous All |
| CFD_M-213-N.png | Unique Ambiguous First |
| CFD_M-223-N.png | Unique Ambiguous First |
Difference of means per image by display with a cutoff of 15 points difference between the ratings
Code
data_images_comparison_15 <- data_participants_first_only |>
group_by(image, display) |>
summarize(average_rating = mean(Response, na.rm = TRUE), .groups = 'drop') |>
spread(key = display, value = average_rating) |>
mutate(avg_diff = `task_Jewish` - `task_Arab`) |>
mutate(rated_ethnicity = case_when(
avg_diff < -15 ~ "Arab",
avg_diff > 15 ~ "Jewish",
TRUE ~ "Ambiguous"
)) |>
mutate(avg_diff = abs(avg_diff)) |>
arrange(avg_diff)
data_images_big_diff_15_first <- data_images_comparison_15 |>
dplyr::filter(abs(avg_diff) >= 15) |>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
data_images_choosen_15_first <- data_images_comparison_15 |>
dplyr::filter(abs(avg_diff)<15)|>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
kable(data_images_comparison_15, caption = "Difference of means with a cutoff of 15 points")| image | task_Arab | task_Jewish | avg_diff | rated_ethnicity |
|---|---|---|---|---|
| CFD_M-220-N.png | 26.86364 | 26.90 | 0.0363636 | Ambiguous |
| CFD_M-242-N.png | 21.63636 | 21.90 | 0.2636364 | Ambiguous |
| IFD_M-018-N.png | 48.40909 | 47.60 | 0.8090909 | Ambiguous |
| IFD_M-416-N.png | 55.77273 | 54.95 | 0.8227273 | Ambiguous |
| CFD_M-236-N.png | 45.09091 | 43.70 | 1.3909091 | Ambiguous |
| CFD_M-227-N.png | 26.81818 | 28.60 | 1.7818182 | Ambiguous |
| CFD_M-211-N.png | 29.18182 | 31.05 | 1.8681818 | Ambiguous |
| IFD_M-419-N.png | 52.04545 | 54.00 | 1.9545455 | Ambiguous |
| IFD_M-135-N.png | 52.00000 | 55.30 | 3.3000000 | Ambiguous |
| CFD_M-206-N.png | 29.72727 | 25.90 | 3.8272727 | Ambiguous |
| CFD_M-225-N.png | 22.77273 | 18.50 | 4.2727273 | Ambiguous |
| CFD_M-224-N.png | 36.95455 | 41.30 | 4.3454545 | Ambiguous |
| CFD_M-218-N.png | 32.59091 | 27.95 | 4.6409091 | Ambiguous |
| CFD_M-212-N.png | 24.81818 | 29.80 | 4.9818182 | Ambiguous |
| CFD_M-243-N.png | 30.40909 | 25.35 | 5.0590909 | Ambiguous |
| CFD_M-216-N.png | 22.45455 | 16.25 | 6.2045455 | Ambiguous |
| CFD_M-213-N.png | 34.36364 | 28.00 | 6.3636364 | Ambiguous |
| IFD_M-067-N.png | 40.95455 | 34.50 | 6.4545455 | Ambiguous |
| CFD_M-223-N.png | 30.36364 | 23.80 | 6.5636364 | Ambiguous |
| CFD_M-248-N.png | 20.59091 | 27.90 | 7.3090909 | Ambiguous |
| CFD_M-229-N.png | 29.59091 | 22.10 | 7.4909091 | Ambiguous |
| IFD_M-105-N.png | 44.00000 | 53.55 | 9.5500000 | Ambiguous |
| CFD_M-237-N.png | 43.54545 | 33.85 | 9.6954545 | Ambiguous |
| IFD_M-424-N.png | 45.00000 | 34.65 | 10.3500000 | Ambiguous |
| CFD_M-234-N.png | 18.54545 | 28.95 | 10.4045455 | Ambiguous |
| IFD_M-086-N.png | 30.72727 | 41.35 | 10.6227273 | Ambiguous |
| CFD_M-214-N.png | 15.90909 | 27.00 | 11.0909091 | Ambiguous |
| CFD_M-251-N.png | 25.54545 | 36.90 | 11.3545455 | Ambiguous |
| IFD_M-108-N.png | 56.59091 | 45.05 | 11.5409091 | Ambiguous |
| IFD_M-418-N.png | 43.50000 | 55.35 | 11.8500000 | Ambiguous |
| CFD_M-247-N.png | 31.40909 | 19.50 | 11.9090909 | Ambiguous |
| IFD_M-117-N.png | 35.36364 | 47.35 | 11.9863636 | Ambiguous |
| CFD_M-210-N.png | 41.95455 | 27.75 | 14.2045455 | Ambiguous |
| IFD_M-421-N.png | 45.09091 | 59.30 | 14.2090909 | Ambiguous |
| IFD_M-075-N.png | 57.09091 | 41.90 | 15.1909091 | Arab |
| IFD_M-121-N.png | 37.72727 | 53.30 | 15.5727273 | Jewish |
| CFD_M-204-N.png | 36.04545 | 52.15 | 16.1045455 | Jewish |
| IFD_M-132-N.png | 46.31818 | 62.55 | 16.2318182 | Jewish |
| CFD_M-222-N.png | 17.40909 | 33.80 | 16.3909091 | Jewish |
| CFD_M-200-N.png | 19.40909 | 35.90 | 16.4909091 | Jewish |
| CFD_M-253-N.png | 21.22727 | 38.10 | 16.8727273 | Jewish |
| IFD_M-051-N.png | 57.09091 | 39.75 | 17.3409091 | Arab |
| CFD_M-221-N.png | 23.81818 | 41.75 | 17.9318182 | Jewish |
| CFD_M-246-N.png | 43.45455 | 24.30 | 19.1545455 | Arab |
| CFD_M-231-N.png | 19.77273 | 39.00 | 19.2272727 | Jewish |
| IFD_M-136-N.png | 63.40909 | 44.05 | 19.3590909 | Arab |
| IFD_M-033-N.png | 42.90909 | 62.35 | 19.4409091 | Jewish |
| IFD_M-062-N.png | 67.90909 | 47.35 | 20.5590909 | Arab |
| CFD_M-230-N.png | 54.81818 | 34.15 | 20.6681818 | Arab |
| IFD_M-420-N.png | 49.31818 | 27.80 | 21.5181818 | Arab |
| IFD_M-111-N.png | 66.77273 | 45.05 | 21.7227273 | Arab |
| IFD_M-042-N.png | 62.68182 | 40.80 | 21.8818182 | Arab |
| IFD_M-122-N.png | 40.81818 | 62.90 | 22.0818182 | Jewish |
| IFD_M-100-N.png | 41.54545 | 64.25 | 22.7045455 | Jewish |
| IFD_M-084-N.png | 60.36364 | 37.60 | 22.7636364 | Arab |
| IFD_M-087-N.png | 32.77273 | 55.55 | 22.7772727 | Jewish |
| CFD_M-239-N.png | 48.81818 | 25.70 | 23.1181818 | Arab |
| IFD_M-044-N.png | 60.00000 | 35.75 | 24.2500000 | Arab |
| CFD_M-235-N.png | 50.86364 | 26.25 | 24.6136364 | Arab |
| IFD_M-015-N.png | 32.77273 | 57.50 | 24.7272727 | Jewish |
| IFD_M-097-N.png | 65.09091 | 39.50 | 25.5909091 | Arab |
| IFD_M-036-N.png | 36.09091 | 62.50 | 26.4090909 | Jewish |
| IFD_M-021-N.png | 36.95455 | 64.65 | 27.6954545 | Jewish |
| IFD_M-113-N.png | 24.59091 | 52.85 | 28.2590909 | Jewish |
| CFD_M-232-N.png | 51.00000 | 21.95 | 29.0500000 | Arab |
| IFD_M-441-N.png | 28.72727 | 57.95 | 29.2227273 | Jewish |
| IFD_M-032-N.png | 64.13636 | 34.70 | 29.4363636 | Arab |
| IFD_M-035-N.png | 35.00000 | 65.50 | 30.5000000 | Jewish |
| CFD_M-250-N.png | 17.77273 | 48.45 | 30.6772727 | Jewish |
| CFD_M-252-N.png | 58.31818 | 27.30 | 31.0181818 | Arab |
| IFD_M-114-N.png | 23.31818 | 54.40 | 31.0818182 | Jewish |
| IFD_M-049-N.png | 73.59091 | 41.25 | 32.3409091 | Arab |
| CFD_M-238-N.png | 53.22727 | 19.95 | 33.2772727 | Arab |
| IFD_M-020-N.png | 65.81818 | 31.25 | 34.5681818 | Arab |
| IFD_M-017-N.png | 28.18182 | 64.75 | 36.5681818 | Jewish |
| CFD_M-201-N.png | 22.81818 | 62.95 | 40.1318182 | Jewish |
| IFD_M-069-N.png | 68.45455 | 27.50 | 40.9545455 | Arab |
| IFD_M-423-N.png | 68.22727 | 25.20 | 43.0272727 | Arab |
| IFD_M-028-N.png | 21.45455 | 65.05 | 43.5954545 | Jewish |
| CFD_M-202-N.png | 68.72727 | 15.35 | 53.3772727 | Arab |
| IFD_M-066-N.png | 85.40909 | 31.15 | 54.2590909 | Arab |
| IFD_M-107-N.png | 74.63636 | 19.95 | 54.6863636 | Arab |
| IFD_M-045-N.png | 84.95455 | 25.90 | 59.0545455 | Arab |
| IFD_M-039-N.png | 79.86364 | 18.00 | 61.8636364 | Arab |
| IFD_M-046-N.png | 84.31818 | 15.20 | 69.1181818 | Arab |
Code
saveRDS(data_images_15, file = "C:/Users/97252/Documents/GitHub/face_cater/PILOT- 1 face categorization/Data/final_data.rdx")Summary Table:
Code
summary_table_15 <- data_images_comparison_15 |>
count(rated_ethnicity) |>
spread(key = rated_ethnicity, value = n)
# Print the summary table
kable(summary_table_15, format = "html", table.attr = "style='width:50%;'", caption = "Summary of Rated Ethnicity")| Ambiguous | Arab | Jewish |
|---|---|---|
| 34 | 28 | 23 |
Comparing rating when taking into account all conditions VS only the first display:
Lets compare between the images when calculating the ratings based on all conditions VS when calculating only the firs retings:
Code
ambiguous_images_comparison_15 <- merge(data_images_15, data_images_comparison_15, by = "image", suffixes = c("_all", "_first"))
# Extracting 'Ambiguous' images from both datasets
ambiguous_images_all_15 = filter(data_images_15, rated_ethnicity == "Ambiguous")$image
ambiguous_images_first_15 = filter(data_images_comparison_15, rated_ethnicity == "Ambiguous")$image
# Finding common 'Ambiguous' images in both datasets
common_ambiguous_images_15 = intersect(ambiguous_images_all_15, ambiguous_images_first_15)
# Finding 'Ambiguous' images unique to the all conditions dataset
unique_ambiguous_all_15 = setdiff(ambiguous_images_all_15, ambiguous_images_first_15)
# Finding 'Ambiguous' images unique to the first ratings dataset
unique_ambiguous_first_15 = setdiff(ambiguous_images_first_15, ambiguous_images_all_15)
# Creating a summary table
summary_comparison_15 <- tibble(
Common_Ambiguous_15 = length(common_ambiguous_images_15),
Unique_Ambiguous_All_15 = length(unique_ambiguous_all_15),
Unique_Ambiguous_First_15 = length(unique_ambiguous_first_15)
)
# Display the summary
knitr::kable(summary_comparison_15,
caption = "Comparison of Ambiguous Images Across Different Conditions 15",
align = 'c')| Common_Ambiguous_15 | Unique_Ambiguous_All_15 | Unique_Ambiguous_First_15 |
|---|---|---|
| 30 | 5 | 4 |
Now let’s see the images id:
Code
common_ambiguous_images_df_15 <- tibble(Image = common_ambiguous_images_15, Category = "Common Ambiguous")
unique_ambiguous_all_df_15 <- tibble(Image = unique_ambiguous_all_15, Category = "Unique Ambiguous All")
unique_ambiguous_first_df_15 <- tibble(Image = unique_ambiguous_first_15, Category = "Unique Ambiguous First")
ambiguous_images_comparison_df_15 <- bind_rows(common_ambiguous_images_df_15, unique_ambiguous_all_df_15, unique_ambiguous_first_df_15)
# Display the comprehensive comparison
knitr::kable(ambiguous_images_comparison_df_15,
caption = "Comparison of Ambiguous Images Between All Conditions and First Ratings 15",
align = 'c')| Image | Category |
|---|---|
| CFD_M-242-N.png | Common Ambiguous |
| CFD_M-212-N.png | Common Ambiguous |
| IFD_M-419-N.png | Common Ambiguous |
| CFD_M-236-N.png | Common Ambiguous |
| CFD_M-220-N.png | Common Ambiguous |
| CFD_M-234-N.png | Common Ambiguous |
| CFD_M-206-N.png | Common Ambiguous |
| IFD_M-018-N.png | Common Ambiguous |
| CFD_M-227-N.png | Common Ambiguous |
| CFD_M-224-N.png | Common Ambiguous |
| CFD_M-218-N.png | Common Ambiguous |
| CFD_M-211-N.png | Common Ambiguous |
| IFD_M-108-N.png | Common Ambiguous |
| CFD_M-214-N.png | Common Ambiguous |
| IFD_M-135-N.png | Common Ambiguous |
| IFD_M-416-N.png | Common Ambiguous |
| IFD_M-105-N.png | Common Ambiguous |
| CFD_M-237-N.png | Common Ambiguous |
| CFD_M-216-N.png | Common Ambiguous |
| CFD_M-248-N.png | Common Ambiguous |
| CFD_M-243-N.png | Common Ambiguous |
| CFD_M-229-N.png | Common Ambiguous |
| IFD_M-086-N.png | Common Ambiguous |
| CFD_M-247-N.png | Common Ambiguous |
| IFD_M-067-N.png | Common Ambiguous |
| IFD_M-424-N.png | Common Ambiguous |
| CFD_M-225-N.png | Common Ambiguous |
| IFD_M-421-N.png | Common Ambiguous |
| CFD_M-213-N.png | Common Ambiguous |
| IFD_M-117-N.png | Common Ambiguous |
| CFD_M-253-N.png | Unique Ambiguous All |
| IFD_M-132-N.png | Unique Ambiguous All |
| IFD_M-136-N.png | Unique Ambiguous All |
| IFD_M-420-N.png | Unique Ambiguous All |
| CFD_M-231-N.png | Unique Ambiguous All |
| CFD_M-223-N.png | Unique Ambiguous First |
| CFD_M-251-N.png | Unique Ambiguous First |
| IFD_M-418-N.png | Unique Ambiguous First |
| CFD_M-210-N.png | Unique Ambiguous First |
Difference of means per image by display with a cutoff of 20 points difference between the ratings
Code
data_images_comparison_20 <- data_participants_first_only |>
group_by(image, display) |>
summarize(average_rating = mean(Response, na.rm = TRUE), .groups = 'drop') |>
spread(key = display, value = average_rating) |>
mutate(avg_diff = `task_Jewish` - `task_Arab`) |>
mutate(rated_ethnicity = case_when(
avg_diff < -20 ~ "Arab",
avg_diff > 20 ~ "Jewish",
TRUE ~ "Ambiguous"
)) |>
mutate(avg_diff = abs(avg_diff)) |>
arrange(avg_diff)
data_images_big_diff_20_first <- data_images_comparison_20 |>
dplyr::filter(abs(avg_diff) >= 20) |>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
data_images_choosen_20_first <- data_images_comparison_20 |>
dplyr::filter(abs(avg_diff)<20)|>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
kable(data_images_comparison_20, caption = "Difference of means with a cutoff of 20 points")| image | task_Arab | task_Jewish | avg_diff | rated_ethnicity |
|---|---|---|---|---|
| CFD_M-220-N.png | 26.86364 | 26.90 | 0.0363636 | Ambiguous |
| CFD_M-242-N.png | 21.63636 | 21.90 | 0.2636364 | Ambiguous |
| IFD_M-018-N.png | 48.40909 | 47.60 | 0.8090909 | Ambiguous |
| IFD_M-416-N.png | 55.77273 | 54.95 | 0.8227273 | Ambiguous |
| CFD_M-236-N.png | 45.09091 | 43.70 | 1.3909091 | Ambiguous |
| CFD_M-227-N.png | 26.81818 | 28.60 | 1.7818182 | Ambiguous |
| CFD_M-211-N.png | 29.18182 | 31.05 | 1.8681818 | Ambiguous |
| IFD_M-419-N.png | 52.04545 | 54.00 | 1.9545455 | Ambiguous |
| IFD_M-135-N.png | 52.00000 | 55.30 | 3.3000000 | Ambiguous |
| CFD_M-206-N.png | 29.72727 | 25.90 | 3.8272727 | Ambiguous |
| CFD_M-225-N.png | 22.77273 | 18.50 | 4.2727273 | Ambiguous |
| CFD_M-224-N.png | 36.95455 | 41.30 | 4.3454545 | Ambiguous |
| CFD_M-218-N.png | 32.59091 | 27.95 | 4.6409091 | Ambiguous |
| CFD_M-212-N.png | 24.81818 | 29.80 | 4.9818182 | Ambiguous |
| CFD_M-243-N.png | 30.40909 | 25.35 | 5.0590909 | Ambiguous |
| CFD_M-216-N.png | 22.45455 | 16.25 | 6.2045455 | Ambiguous |
| CFD_M-213-N.png | 34.36364 | 28.00 | 6.3636364 | Ambiguous |
| IFD_M-067-N.png | 40.95455 | 34.50 | 6.4545455 | Ambiguous |
| CFD_M-223-N.png | 30.36364 | 23.80 | 6.5636364 | Ambiguous |
| CFD_M-248-N.png | 20.59091 | 27.90 | 7.3090909 | Ambiguous |
| CFD_M-229-N.png | 29.59091 | 22.10 | 7.4909091 | Ambiguous |
| IFD_M-105-N.png | 44.00000 | 53.55 | 9.5500000 | Ambiguous |
| CFD_M-237-N.png | 43.54545 | 33.85 | 9.6954545 | Ambiguous |
| IFD_M-424-N.png | 45.00000 | 34.65 | 10.3500000 | Ambiguous |
| CFD_M-234-N.png | 18.54545 | 28.95 | 10.4045455 | Ambiguous |
| IFD_M-086-N.png | 30.72727 | 41.35 | 10.6227273 | Ambiguous |
| CFD_M-214-N.png | 15.90909 | 27.00 | 11.0909091 | Ambiguous |
| CFD_M-251-N.png | 25.54545 | 36.90 | 11.3545455 | Ambiguous |
| IFD_M-108-N.png | 56.59091 | 45.05 | 11.5409091 | Ambiguous |
| IFD_M-418-N.png | 43.50000 | 55.35 | 11.8500000 | Ambiguous |
| CFD_M-247-N.png | 31.40909 | 19.50 | 11.9090909 | Ambiguous |
| IFD_M-117-N.png | 35.36364 | 47.35 | 11.9863636 | Ambiguous |
| CFD_M-210-N.png | 41.95455 | 27.75 | 14.2045455 | Ambiguous |
| IFD_M-421-N.png | 45.09091 | 59.30 | 14.2090909 | Ambiguous |
| IFD_M-075-N.png | 57.09091 | 41.90 | 15.1909091 | Ambiguous |
| IFD_M-121-N.png | 37.72727 | 53.30 | 15.5727273 | Ambiguous |
| CFD_M-204-N.png | 36.04545 | 52.15 | 16.1045455 | Ambiguous |
| IFD_M-132-N.png | 46.31818 | 62.55 | 16.2318182 | Ambiguous |
| CFD_M-222-N.png | 17.40909 | 33.80 | 16.3909091 | Ambiguous |
| CFD_M-200-N.png | 19.40909 | 35.90 | 16.4909091 | Ambiguous |
| CFD_M-253-N.png | 21.22727 | 38.10 | 16.8727273 | Ambiguous |
| IFD_M-051-N.png | 57.09091 | 39.75 | 17.3409091 | Ambiguous |
| CFD_M-221-N.png | 23.81818 | 41.75 | 17.9318182 | Ambiguous |
| CFD_M-246-N.png | 43.45455 | 24.30 | 19.1545455 | Ambiguous |
| CFD_M-231-N.png | 19.77273 | 39.00 | 19.2272727 | Ambiguous |
| IFD_M-136-N.png | 63.40909 | 44.05 | 19.3590909 | Ambiguous |
| IFD_M-033-N.png | 42.90909 | 62.35 | 19.4409091 | Ambiguous |
| IFD_M-062-N.png | 67.90909 | 47.35 | 20.5590909 | Arab |
| CFD_M-230-N.png | 54.81818 | 34.15 | 20.6681818 | Arab |
| IFD_M-420-N.png | 49.31818 | 27.80 | 21.5181818 | Arab |
| IFD_M-111-N.png | 66.77273 | 45.05 | 21.7227273 | Arab |
| IFD_M-042-N.png | 62.68182 | 40.80 | 21.8818182 | Arab |
| IFD_M-122-N.png | 40.81818 | 62.90 | 22.0818182 | Jewish |
| IFD_M-100-N.png | 41.54545 | 64.25 | 22.7045455 | Jewish |
| IFD_M-084-N.png | 60.36364 | 37.60 | 22.7636364 | Arab |
| IFD_M-087-N.png | 32.77273 | 55.55 | 22.7772727 | Jewish |
| CFD_M-239-N.png | 48.81818 | 25.70 | 23.1181818 | Arab |
| IFD_M-044-N.png | 60.00000 | 35.75 | 24.2500000 | Arab |
| CFD_M-235-N.png | 50.86364 | 26.25 | 24.6136364 | Arab |
| IFD_M-015-N.png | 32.77273 | 57.50 | 24.7272727 | Jewish |
| IFD_M-097-N.png | 65.09091 | 39.50 | 25.5909091 | Arab |
| IFD_M-036-N.png | 36.09091 | 62.50 | 26.4090909 | Jewish |
| IFD_M-021-N.png | 36.95455 | 64.65 | 27.6954545 | Jewish |
| IFD_M-113-N.png | 24.59091 | 52.85 | 28.2590909 | Jewish |
| CFD_M-232-N.png | 51.00000 | 21.95 | 29.0500000 | Arab |
| IFD_M-441-N.png | 28.72727 | 57.95 | 29.2227273 | Jewish |
| IFD_M-032-N.png | 64.13636 | 34.70 | 29.4363636 | Arab |
| IFD_M-035-N.png | 35.00000 | 65.50 | 30.5000000 | Jewish |
| CFD_M-250-N.png | 17.77273 | 48.45 | 30.6772727 | Jewish |
| CFD_M-252-N.png | 58.31818 | 27.30 | 31.0181818 | Arab |
| IFD_M-114-N.png | 23.31818 | 54.40 | 31.0818182 | Jewish |
| IFD_M-049-N.png | 73.59091 | 41.25 | 32.3409091 | Arab |
| CFD_M-238-N.png | 53.22727 | 19.95 | 33.2772727 | Arab |
| IFD_M-020-N.png | 65.81818 | 31.25 | 34.5681818 | Arab |
| IFD_M-017-N.png | 28.18182 | 64.75 | 36.5681818 | Jewish |
| CFD_M-201-N.png | 22.81818 | 62.95 | 40.1318182 | Jewish |
| IFD_M-069-N.png | 68.45455 | 27.50 | 40.9545455 | Arab |
| IFD_M-423-N.png | 68.22727 | 25.20 | 43.0272727 | Arab |
| IFD_M-028-N.png | 21.45455 | 65.05 | 43.5954545 | Jewish |
| CFD_M-202-N.png | 68.72727 | 15.35 | 53.3772727 | Arab |
| IFD_M-066-N.png | 85.40909 | 31.15 | 54.2590909 | Arab |
| IFD_M-107-N.png | 74.63636 | 19.95 | 54.6863636 | Arab |
| IFD_M-045-N.png | 84.95455 | 25.90 | 59.0545455 | Arab |
| IFD_M-039-N.png | 79.86364 | 18.00 | 61.8636364 | Arab |
| IFD_M-046-N.png | 84.31818 | 15.20 | 69.1181818 | Arab |
Code
saveRDS(data_images_20, file = "C:/Users/97252/Documents/GitHub/face_cater/PILOT- 1 face categorization/Data/final_data.rdx")Summary Table:
Code
summary_table_20 <- data_images_comparison_20 |>
count(rated_ethnicity) |>
spread(key = rated_ethnicity, value = n)
# Print the summary table
kable(summary_table_20, format = "html", table.attr = "style='width:50%;'", caption = "Summary of Rated Ethnicity")| Ambiguous | Arab | Jewish |
|---|---|---|
| 47 | 24 | 14 |
Comparing rating when taking into account all conditions VS only the first display:
Lets compare between the images when calculating the ratings based on all conditions VS when calculating only the first ratings:
Code
ambiguous_images_comparison_20 <- merge(data_images_20, data_images_comparison_20, by = "image", suffixes = c("_all", "_first"))
# Extracting 'Ambiguous' images from both datasets
ambiguous_images_all_20 = filter(data_images_20, rated_ethnicity == "Ambiguous")$image
ambiguous_images_first_20 = filter(data_images_comparison_20, rated_ethnicity == "Ambiguous")$image
# Finding common 'Ambiguous' images in both datasets
common_ambiguous_images_20 = intersect(ambiguous_images_all_20, ambiguous_images_first_20)
# Finding 'Ambiguous' images unique to the all conditions dataset
unique_ambiguous_all_20 = setdiff(ambiguous_images_all_20, ambiguous_images_first_20)
# Finding 'Ambiguous' images unique to the first ratings dataset
unique_ambiguous_first_20 = setdiff(ambiguous_images_first_20, ambiguous_images_all_20)
# Creating a summary table
summary_comparison_20 <- tibble(
Common_Ambiguous_20 = length(common_ambiguous_images_20),
Unique_Ambiguous_All_20 = length(unique_ambiguous_all_20),
Unique_Ambiguous_First_20 = length(unique_ambiguous_first_20)
)
# Display the summary
knitr::kable(summary_comparison_20,
caption = "Comparison of Ambiguous Images Across Different Conditions 20",
align = 'c')| Common_Ambiguous_20 | Unique_Ambiguous_All_20 | Unique_Ambiguous_First_20 |
|---|---|---|
| 43 | 8 | 4 |
Now let’s see the images id:
Code
common_ambiguous_images_df_20 <- tibble(Image = common_ambiguous_images_20, Category = "Common Ambiguous")
unique_ambiguous_all_df_20 <- tibble(Image = unique_ambiguous_all_20, Category = "Unique Ambiguous All")
unique_ambiguous_first_df_20 <- tibble(Image = unique_ambiguous_first_20, Category = "Unique Ambiguous First")
ambiguous_images_comparison_df_20 <- bind_rows(common_ambiguous_images_df_20, unique_ambiguous_all_df_20, unique_ambiguous_first_df_20)
# Display the comprehensive comparison
knitr::kable(ambiguous_images_comparison_df_20,
caption = "Comparison of Ambiguous Images Between All Conditions and First Ratings 20",
align = 'c')| Image | Category |
|---|---|
| CFD_M-242-N.png | Common Ambiguous |
| CFD_M-212-N.png | Common Ambiguous |
| IFD_M-419-N.png | Common Ambiguous |
| CFD_M-236-N.png | Common Ambiguous |
| CFD_M-220-N.png | Common Ambiguous |
| CFD_M-234-N.png | Common Ambiguous |
| CFD_M-206-N.png | Common Ambiguous |
| IFD_M-018-N.png | Common Ambiguous |
| CFD_M-227-N.png | Common Ambiguous |
| CFD_M-224-N.png | Common Ambiguous |
| CFD_M-218-N.png | Common Ambiguous |
| CFD_M-211-N.png | Common Ambiguous |
| IFD_M-108-N.png | Common Ambiguous |
| CFD_M-214-N.png | Common Ambiguous |
| IFD_M-135-N.png | Common Ambiguous |
| IFD_M-416-N.png | Common Ambiguous |
| IFD_M-105-N.png | Common Ambiguous |
| CFD_M-237-N.png | Common Ambiguous |
| CFD_M-216-N.png | Common Ambiguous |
| CFD_M-248-N.png | Common Ambiguous |
| CFD_M-243-N.png | Common Ambiguous |
| CFD_M-229-N.png | Common Ambiguous |
| IFD_M-086-N.png | Common Ambiguous |
| CFD_M-247-N.png | Common Ambiguous |
| IFD_M-067-N.png | Common Ambiguous |
| CFD_M-253-N.png | Common Ambiguous |
| IFD_M-424-N.png | Common Ambiguous |
| CFD_M-225-N.png | Common Ambiguous |
| IFD_M-132-N.png | Common Ambiguous |
| IFD_M-421-N.png | Common Ambiguous |
| IFD_M-136-N.png | Common Ambiguous |
| CFD_M-213-N.png | Common Ambiguous |
| IFD_M-117-N.png | Common Ambiguous |
| CFD_M-231-N.png | Common Ambiguous |
| CFD_M-222-N.png | Common Ambiguous |
| CFD_M-223-N.png | Common Ambiguous |
| CFD_M-246-N.png | Common Ambiguous |
| IFD_M-075-N.png | Common Ambiguous |
| IFD_M-121-N.png | Common Ambiguous |
| CFD_M-204-N.png | Common Ambiguous |
| CFD_M-251-N.png | Common Ambiguous |
| CFD_M-200-N.png | Common Ambiguous |
| CFD_M-221-N.png | Common Ambiguous |
| IFD_M-420-N.png | Unique Ambiguous All |
| IFD_M-062-N.png | Unique Ambiguous All |
| CFD_M-230-N.png | Unique Ambiguous All |
| IFD_M-036-N.png | Unique Ambiguous All |
| IFD_M-100-N.png | Unique Ambiguous All |
| IFD_M-042-N.png | Unique Ambiguous All |
| IFD_M-122-N.png | Unique Ambiguous All |
| IFD_M-044-N.png | Unique Ambiguous All |
| IFD_M-418-N.png | Unique Ambiguous First |
| CFD_M-210-N.png | Unique Ambiguous First |
| IFD_M-051-N.png | Unique Ambiguous First |
| IFD_M-033-N.png | Unique Ambiguous First |
Visualization with ggplot2:
Responses and overall trends per image by display
Visualizing image ratings in both display forms.
Code
plot_images_first <- data_participants_first_only |>
group_by(display, image) |>
mutate(per_condition_mean = mean(Response, na.rm = T)) |>
#filter(str_detect(image, pattern = "20")) |>
ggplot(aes(x = display, y = Response)) +
geom_point() +
geom_point(aes(y = per_condition_mean, color = "red"), show.legend = F) +
facet_wrap(~image, scales = "fixed") +
scale_y_continuous(labels = seq(0, 100, 10), breaks = seq(0, 100, 10)) +
theme(axis.text.x = element_text(angle = 90, vjust = .5, hjust = 1)) +
theme_classic()
ggsave("plot_images_without_all_first.png", plot = plot_images_first, path = "../Plots_first/", width = 4000, height = 4000, units = "px")
Participants ratings- individual participant responses and overall trends
Adding lines that connects between the ratings of each image:
Code
plot_participants_with_line_first <- data_participants_order |>
ggplot(aes(x = display, y = Response)) +
geom_smooth(aes(x = display, y = Response, group = image), method = "lm", color = "gray84", se = F, inherit.aes = F) +
geom_smooth(aes(group = -1), method = "lm", se = F, color = "red") +
facet_wrap(~Participant_Private_ID) +
scale_y_continuous(limits = c(0, 100)) +
theme_classic()
ggsave("plot_line_participants_without_All.png", plot = plot_participants_with_line_first, path = "../Plots_first/", width = 4000, height = 4000, units = "px")
Visual stimuli:
References
Bakker, Marjan, and Jelte M Wicherts. 2014. “Outlier Removal, Sum Scores, and the Inflation of the Type i Error Rate in Independent Samples t Tests: The Power of Alternatives and Recommendations.” Psychological Methods 19 (3): 409.